perm filename ITMX.F4[XX,LCS] blob sn#195565 filedate 1976-01-08 generic text, type T, neo UTF8
00100	C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE ITMSUB
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700		1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800	C  RDBR IS SPACER FOR DBL BAR.
01900	C  RTF COMPENSATES FOR BAD PLANNING.
01950		IF(JA.EQ.4)GO TO 90
01960		CALL BMSTF
01970		RETURN
02000	90	RST7=RSTJ2*7.
02100		RST18=RSTJ2*18.
02200	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300	
02400		R3Q=R3
02500	CC???	JY=0
02600	CC	IF(JA.EQ.6)GO TO 90
02700	CC	IF(JA.EQ.8)GO TO 100
02800	C  GO TO LINES, BEAMS, STAVES.
02900	C   NEXT DRAWS STRAIGHT LINES
03000	
03100		RD=R4*RST7
03200		RA=0
03300		RX=RTF*RSTJ2+POS
03400	C  SOMEDAY ADD < RDIS=1./DIS >  TO REPLACE ALL 1./DIS'S
03500		IF(J5.EQ.50)GO TO 300
03600	C  50 IS FOR CRESC., DECRESC. AND BOXES
03700		IF(R6.NE.0)GO TO 401
03800		IF(J7.NE.0)GO TO 401
03900	C  FOR BAR LINES
04000	4000	JA=44
04100	C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04200	C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04300		DBR=0 
04400		IF(J4.LT.1000)GO TO 400
04500	C  J4=1001 = DBL BAR,  =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04600	CK	J4=J4-1000
04700	CK	DBR=-1
04800	CK400	J7=(J4/100)*DIS
04900		DBR=J4/1000
05000		J4=J4-DBR*1000
05100	C DBR=1 HEAVY BAR IS ON RT.  =2 ON LEFT.  =3 IN MIDDLE.
05200	9400	RD=RDBR+RDBR*RSTJ2
05300	C  TO SPACE THIN BAR FROM HEAVY
05400		IF(J5.EQ.0)GO TO 400
05500	C  NEXT ADDS REPEAT DOTS TO DBL BAR.
05600		L=J4
05700		RJ=L/100
05800		IF(RJ.EQ.0)RJ=6.*RSTJ2
05900	C HEAVY BAR WILL BE 5 LINES WIDE.
05910		RZ=R3
06000		J4=0
06100	C  MUST BE 0 FOR DOTS IN 'NOTWRT'
06200		IF(DBR.EQ.0)DBR=J5
06300		J5=0
06400	C J5=1 RPT ←, =2 RPT →, =3 RPT ↔
06500		RJA=RD*2.
06600	C  TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06700		JY=DBR
06800		IF(DBR.LT.2)GO TO 8400
06900		R3=RJA+RJ+RZ
07000	7400	DO 3400 K=J2,MOD(L,100)+J2-1
07100		RSTJ2=RSTFAC(K)
07200		POS=STFF(K)
07300		R4=6
07400		CALL CENTX
07500	C  SPACES DOTS OUT FROM BAR
07600		CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07700	C  GO GET THE DOT
07800		R4=8
07900		CALL CENTX
08000	3400	CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
08100		JY=JY-1
08200		IF(JY.LT.2)GO TO 4400
08300	8400	R3=RZ-RJA-4.*RSTJ2
08400		GO TO 7400
08500	C  DO I NEED ANY MORE RESETS????
08600	4400	J4=L
08610		J7=RJ*DIS
08620		GO TO 5400
08700	400	IF(J5.NE.0)GO TO 9400
08800		K=J4/100
08900	C  K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
09000		J7=K*DIS
09100	C  J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09200	5400	L=MOD(J4,100)
09300		IF(L.EQ.0)L=1
09400		L=L+J2-1
09500	C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09600		RA=RTF
09700		IF(L.LE.4)GO TO 2400
09800		L=4
09900		RA=300.
10000	C FOR EXTENDING BARS ABOVE STAFF 4
10100	2400	RY=RSTFAC(L)
10110		RZ=R3Q
10155	C  SAVE IT FOR DBL RPT BAR.
10200		RY=STFF(L)+(RA+56.)*RY
10300	1400	RA=1
10400		IF(PLT.GE.0)GO TO 140
10500		J7=J7+1
10600		RA=1./DIS
10700	C  BAR LINES PLOT AS DOUBLE THICKNESS
10800	140	RJX=R3Q
10900	42	CALL LINES(R3Q,RX,3)
11000		RJ=-1.
11100		RW=RY
11200	406	CALL LINES(RJX,RY,2)
11300		IF(J10.EQ.0)GO TO 411
11400	C  P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11500		J7=J10*DIS
11600		J10=0
11700		RA=1./DIS
11800	411	IF(J7.GT.0)GO TO 409
11900		IF(DBR.LE.0)RETURN
12000		RY=RW
12100	CK	R3Q=R3Q-RDBR
12200		RA=RJX+RD
12300		IF(DBR.EQ.1)RA=RZ-RD
12400		DBR=DBR-2
12500		R3Q=RA
12600		GO TO 1400
12700	CC411	IF(J7.LE.0)RETURN
12800	C  FOR 'HEAVY' LINE.
12900	409	RJX=RJX+RA
13000		CALL LINES(RJX,RY,2)
13100		J7=J7-1
13200		RY=RW
13300		IF(RJ)RY=RX
13400		RJ=-RJ
13500		GO TO 406
13600	CC43	IF(RA.LE.0)RETURN
13700	C   HOW IS RA.NE.0?
13800	C  DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
13900	CC403	RA=RA-3.72
14000	CC	R3Q=R3Q+22
14100	CC	RJX=RJX+22
14200	C   DO ABOVE NEED *RSTJ2? ************
14300	C **** BASED ON '596' ****
14400	CC	GO TO 42
14500	
14600	C  FOR CRESC., DECRESC.
14700	300	IF(R7.EQ.0)R7=2.3
14800		IF(R7.EQ.-1.)R7=-2.3
14900		RA=ABS(R7/2.0)*RST7
15000	C   AMOUNT OF SPREAD
15100		RJ=R3Q
15200		RX=RX-RST18+RD
15300		IF(R8.NE.0)GO TO 302
15400	C  JUMP TO MAKE BOX
15500		R6=RHORZ(R6)
15600		IF(R7)GO TO 301
15700		RJ=R6
15800		R6=R3Q
15900	301	CALL LINX(RJ,RX+RA,R6,RX)
16000		CALL LINES(RJ,RX-RA,2)
16100	C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16200	CC	IF(PLT.NE.-2)RETURN
16300		IF(PLT.GE.0)RETURN
16400	C  THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16500		IF(J8)RETURN
16600		RX=RX+1./DIS
16700		J8=-1
16800	C FOR DOUBLE THICKNESS
16900		GO TO 301
17000	
17100	302	R8=R8*RST7
17200		R9=R9*RST7
17300		IF(R9.EQ.0)R9=R8
17400	C  R9=0 MAKES SQUARE    
17500		R3=R3Q-R8/2.
17600		RX=RX-R9/2.
17700		J10=J10*DIS
17800	C  DRAWS BOX, CENTER IS IN MIDDLE 
17900	C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
18000	1302	CALL LINX(R3,RX,R3+R8,RX)
18100		CALL LINES(R3+R8,RX+R9,2)
18200		CALL LINES(R3,RX+R9,2)
18300		CALL LINES(R3,RX,2)
18400		IF(J10.EQ.0)RETURN
18500		J10=J10-1
18600		RJ=1./DIS
18700		R3=R3-RJ
18800		R8=R8+RJ+RJ
18900		RX=RX-RJ
19000		R9=R9+RJ+RJ
19100		GO TO 1302
19200	C  TO THICKEN BOXES.
19300	
19400	1401	R4=2.0
19500	C FOR HEAVY BRACK.
19600		RA=RSTJ2*RBX
19700		RX=RX-RA
19800	C  THE BOTTOM
19900		L=J4+J2-1
20000		R6=RTF
20100		IF(L.LE.4)GO TO 4401
20200		L=4
20300		R6=300.
20400	4401	RA=STFF(L)
20500	C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20600		RJY=RSTFAC(L)
20700		RY=RA+R6*RJY+RJY*56.+RJY*RBX
20800	C  THE TOP
20900		R5=9.5
21000		GO TO 2401
21100	
21200	C  DASHES
21300	401	POS=POS-RST18
21400	C********* 27/9/72 ******
21500		IF(J7.LE.0)GO TO 407
21600		IF(J7.EQ.4)GO TO 1401
21700		IF(J7.NE.3)GO TO 4001
21800	C  NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
21900	2401	JA=3
22000		IF(J10.EQ.0)J10=5
22100	C  DEFAULT VALUE FOR THICKNESS =5
22200		R4=R4-RBR
22300		J9=0
22400		J5=35
22500	C  THE NUM FOR THE LITTLE END ITEMS
22600	CC	RY=R6-2.1*RSTJ2
22700		R6=3 
22800		R7=0
22900	C DOES LOWER ONE FIRST.  ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23000		IF(J8.NE.2)CALL CLEFS
23100	C P8=1=BOTTOM 1/2 BRACK. ONLY:  =2=TOP 1/2 ONLY:  0=COMPLETE
23200		R4=R5-RBR
23300		R6=3
23400		R7=-3
23500	C  TURNS IT UPSIDE DOWN.
23600	CC	JA=3
23700		IF(J7.NE.4)GO TO 3401
23800		POS=RA
23900		R4=R4*RJY/RSTJ2
24000	C  TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24100	3401	IF(J8.NE.1)CALL CLEFS
24200		R3Q=R3Q-12.0*RSTJ2
24300		IF(J7.NE.4)GO TO 407
24400		J7=0
24500		GO TO 140
24600	
24700	4002	J5=4
24800	C FOR CURVY BRACKET.  P6 CAN CHANGE WIDTH.
24900		R8=0
25000		J4=J4+J2-1
25100		R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
25200	C  .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25300	C  ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25400		IF(R6.EQ.0)R6=1.+R7/20.
25500		JA=3
25600		R4=2.3
25700	C  C  BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
25800		CALL CLEFS
25900		RETURN
26000	
26100	4001	IF(J7.EQ.5)GO TO 4002
26200		IF(R8.EQ.0)R8=.8
26300	C  P8 CAN SET SIZE OF DASH
26400		RD=RD+POS
26500		IF(J7.EQ.1)GO TO 402
26600	C  =1 =VERTICAL DASHES
26700		RA=RHORZ(R6)
26800		RST7=5.96*RSTJ2
26900		RJX=R3Q
27000		GO TO 420
27100	402	RA=POS+R5*RST7
27200		RJY=RD
27300	C  SAVE FOR THICK LINES
27400	420	RJ=R8*RST7
27500	41	L=3
27600		K=2
27700	416	CALL LINES(R3Q,RD,L)
27800		IF(J7.EQ.1)GO TO 412
27900	C  JUMP FOR VERTICAL DASH
28000		IF(R3Q.GE.RA)GO TO 413
28100	C  JUMP IF ALL DONE
28200		R3Q=R3Q+RJ
28300	414	CALL EXCH(L,K)
28400		GO TO 416
28500	412	IF(RD.GE.RA)GO TO 413
28600	C  JUMP IF DONE
28700		RD=RD+RJ
28800		GO TO 414
28900	413	IF(J10.LE.0)RETURN
29000	C  NEXT FOR THICK DASHES
29100		J10=J10-1
29200		IF(J7.EQ.1)GO TO 415
29300		R3Q=RJX
29400		RD=RD+1./DIS
29500		GO TO 41
29600	415	R3Q=R3Q+1./DIS
29700		RD=RJY
29800		GO TO 41
29900	
30000	
30100	407	RX=RD+POS
30200		RY=R5*RST7+POS
30300		IF(J7.EQ.3)GO TO 140
30400		CALL NOZERO(R9)
30500		IF(J7.EQ.-1)GO TO 408
30600	C  FOR 'TR' J7=-2, 'ARPEGG' J7=-1,  STRAIGHT LINES J7=0
30700	CC  WHY THE IFIX????	RJX=IFIX(RHORZ(R6))
30800		RJX=IFIX(ROFF(RHORZ(R6)))
30900	C  ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31000		IF(J7.EQ.0)GO TO 42
31100		RY=R9*RST7+RX
31200		CALL NOZERO(R8)
31300	4041	RZ=RX
31400		RH=RY
31500	C  SAVE FOR THICK WIGGLES
31600		CALL LINES(R3Q,RX,3)
31700	C  DRAWS STRAIGHT LINES. ETC.
31800		R9=R3Q
31900		RJ=RY
32000		RW=3.*RSTJ2*R8
32100		RA=RW*2.5
32200	C  P8=HORZ. WIGGLE SIZE;  P9=VERT. SIZE
32300	404	R9=R9+RA
32400		CALL LINES(R9,RJ,2)
32500		R9=R9+RW
32600		CALL LINES(R9,RJ,2)
32700	405	CALL EXCH(RX,RJ)
32800		IF(R9.LT.RJX)GO TO 404
32900		IF(J10.LE.0)RETURN
33000		RX=RZ+1./DIS
33100		RY=RH+1./DIS
33200		J10=J10-1
33300		GO TO 4041
33400	C  P10= + NUM OF THICKNESSES TO WIGGLE
33500	
33600	408	IF(RX.GT.RY)CALL EXCH(RX,RY)
33700		RZ=R9*RSTJ2*5.96
33800	C  USE P9 TO SET WIGGLE WIDTH.  P8 TO SET HGT.
33900		CALL NOZERO(R8)
34000		RD=R8*RST7*.5
34100		RJ=RD
34200		IF(RD.LT.1.)RD=1.
34300	421	R9=RX
34400		RW=R3Q
34500		RA=RZ+R3Q
34600		CALL LINES(RW,R9,3)
34700	410	R9=R9+RJ
34800		CALL LINES(RA,R9,2)
34900		R9=R9+RD
35000		CALL LINES(RA,R9,2)
35100		CALL EXCH(RA,RW)
35200		IF(R9.LT.RY)GO TO 410
35300		IF(J10.LE.0)RETURN
35400		R3Q=R3Q+1./DIS
35500		J10=J10-1
35600		GO TO 421
35700	C  VERTICAL WIGGLE   P10=+ NUM OF THICKNESSES.
35800	
35900		END